home *** CD-ROM | disk | FTP | other *** search
/ The 640 MEG Shareware Studio 2 / The 640 Meg Shareware Studio CD-ROM Volume II (Data Express)(1993).ISO / pascal / binhelp.zip / BINARY.PAS < prev   
Pascal/Delphi Source File  |  1992-02-13  |  6KB  |  175 lines
  1. PROGRAM BinaryTreeSample ( INPUT, OUTPUT );
  2.  
  3. USES Crt;
  4.  
  5. TYPE NodePtr     = ^Node;
  6.  
  7.      Node        = RECORD
  8.                     Left,
  9.                     Parent,
  10.                     Right     : WORD;
  11.                     KeyWord   : POINTER;   { Will hold in STRING format }
  12.                    END;                    { Where 1st byte is length   }
  13.  
  14.      Comparison  = (Less, Greater, Equal);
  15.  
  16.  
  17. VAR NewWord  : STRING;                     { Holds word typed in        }
  18.     StartMem : LONGINT;                    { Holds starting memory      }
  19.     Counter,                               { Used for FOR Loop          }
  20.     LastNode : WORD;                       { Holds last node stored     }
  21.     BTree    : ARRAY[1..16000] OF NodePtr; { Entire Binary Tree         }
  22.  
  23.  
  24.  
  25. FUNCTION PtrStr ( Ptr    : POINTER ) : STRING; { Ptr --> String conversion }
  26.  
  27. VAR Str : STRING;
  28.  
  29. BEGIN
  30.  Move( Ptr^, Str, Mem[Seg(Ptr^):Ofs(Ptr^)]+1 );   { +1 to copy count byte }
  31.  PtrStr := Str;
  32. END;
  33.  
  34.  
  35. PROCEDURE Destroy ( VAR P : POINTER );
  36. BEGIN
  37.  FreeMem (P,Mem[Seg(P^):Ofs(P^)]+1);              { Dispose ptr to free mem }
  38. END;
  39.  
  40.  
  41. FUNCTION Compare( Ptr1,                            { Compares two ptrs like }
  42.                   Ptr2   : POINTER ) : Comparison; { strings, returning: <, }
  43.                                                    { >, or =                }
  44. VAR Str1,
  45.     Str2   : STRING;
  46.     Result : Comparison;
  47.  
  48. BEGIN
  49.  Move( Ptr1^, Str1, Mem[Seg(Ptr1^):Ofs(Ptr1^)]+1 );
  50.  Move( Ptr2^, Str2, Mem[Seg(Ptr2^):Ofs(Ptr2^)]+1 );
  51.  IF Str1=Str2 THEN
  52.   Result := Equal
  53.  ELSE
  54.   IF Str1>Str2 THEN
  55.    Result := Greater
  56.   ELSE
  57.    Result := Less;
  58.  Compare := Result;
  59. END;
  60.  
  61.  
  62. PROCEDURE Str_To_Pointer (     Str : STRING;      { Converts Str to Ptr }
  63.                            VAR Ptr : POINTER  );
  64.  
  65. BEGIN
  66.  GetMem(Ptr,Ord(Str[0])+1);
  67.  Move (Str,Ptr^,Ord(Str[0])+1);
  68. END;
  69.  
  70.  
  71. PROCEDURE PlaceWord ( Str : STRING );  { Sort through binary tree, and if }
  72.                                        { the word does not exist, add the }
  73. VAR NewNode        : Node;             { node to the binary tree          }
  74.     Index          : WORD;
  75.     Found,
  76.     SearchFinished : BOOLEAN;
  77.     Comp           : Comparison;
  78.  
  79. BEGIN
  80.  SearchFinished := (LastNode=0);
  81.  Found := FALSE;
  82.  Index := 1;
  83.  WITH NewNode DO                        { Constructs initial full node     }
  84.   BEGIN
  85.    Left := 0;                           { Don't know yet                   }
  86.    Right := 0;                          {  "      "   "                    }
  87.    Parent := 0;                         {  "      "   "                    }
  88.    Str_To_Pointer ( Str, KeyWord );     { This should store the word in ^  }
  89.   END;
  90.  IF SearchFinished THEN
  91.   BEGIN
  92.    Inc(LastNode);                          { Increase LastNode +1    }
  93.    New(BTree[LastNode]);                   { Create next node        }
  94.    BTree[LastNode]^ := NewNode;            { Store new node now      }
  95.   END;
  96.  WHILE NOT (SearchFinished OR Found) DO
  97.   BEGIN
  98.    Comp := Compare(NewNode.Keyword,BTree[Index]^.KeyWord);
  99.    IF Comp=EQUAL THEN
  100.     Found := TRUE
  101.    ELSE
  102.     IF Comp=Less THEN
  103.      BEGIN
  104.       IF BTree[Index]^.Left = 0 THEN            { IF Last branch then     }
  105.        BEGIN                                    { .. lets make a new one  }
  106.         Inc(LastNode);                          { Increase LastNode +1    }
  107.         New(BTree[LastNode]);                   { Create next node        }
  108.         BTree[Index]^.Left := LastNode;         { Point left to next node }
  109.         NewNode.Parent := Index;                { Set parent to index     }
  110.         BTree[LastNode]^ := NewNode;            { Store new node now      }
  111.         SearchFinished := TRUE                  { All finished!           }
  112.        END
  113.       ELSE
  114.        Index := BTree[Index]^.Left
  115.      END
  116.     ELSE                                        { Must be greater then }
  117.      BEGIN
  118.       IF BTree[Index]^.Right = 0 THEN           { IF Last branch then..   }
  119.        BEGIN                                    { .. lets make a new one  }
  120.         Inc(LastNode);                          { Increase LastNode +1    }
  121.         New(BTree[LastNode]);                   { Create next node        }
  122.         BTree[Index]^.Right := LastNode;        { Point left to next node }
  123.         NewNode.Parent := Index;                { Set parent to index     }
  124.         BTree[LastNode]^ := NewNode;            { Store new node now      }
  125.         SearchFinished := TRUE                  { All finished!           }
  126.        END
  127.       ELSE
  128.        Index := BTree[Index]^.Right
  129.      END;
  130.   END;
  131. END;
  132.  
  133. PROCEDURE Init;
  134. BEGIN
  135.  LastNode := 0;
  136. END;
  137.  
  138.  
  139. PROCEDURE DisposeAll;
  140.  
  141. VAR Counter : WORD;
  142.  
  143. BEGIN
  144.  FOR Counter := 1 TO LastNode DO
  145.   BEGIN
  146.    Destroy(BTree[Counter]^.KeyWord);
  147.    Dispose(BTree[Counter]);
  148.   END
  149. END;
  150.  
  151.  
  152. BEGIN
  153.  ClrScr;
  154.  StartMem := MemAvail;
  155.  Init;
  156.  REPEAT
  157.   Write ('Insert new word ["stop" to finish] : ');
  158.   Readln (NewWord);
  159.   IF NewWord <> 'stop' THEN
  160.    PlaceWord ( NewWord );
  161.  UNTIL NewWord='stop';
  162.  Writeln;
  163.  Writeln ('  Node    Left     Parent     Right      Word');
  164.  Writeln ('-----------------------------------------------');
  165.  FOR Counter := 1 TO LastNode DO
  166.   WITH BTree[Counter]^ DO
  167.    Writeln (Counter:5,Left:8,Parent:11,Right:10,'       ',PtrStr(KeyWord));
  168.  Writeln;
  169.  Writeln ('Initial memory availible        : ',StartMem);
  170.  Writeln ('Memory availible before dispose : ',MemAvail);
  171.  DisposeAll;
  172.  Writeln ('Memory availible after clean-up : ',MemAvail);
  173.  Readln;
  174. END.
  175.